home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / FLEXFILE.ARJ / FLEXINFO.EXE / VCONVERT.PRG < prev   
Text File  |  1991-10-21  |  7KB  |  241 lines
  1. *:*********************************************************************
  2. *:
  3. *:        Program: VCONVERT.PRG
  4. *:
  5. *:         System: Flexfile Conversion Program
  6. *:         Author: Don Caton
  7. *:      Copyright:
  8. *:  Last modified: 10/23/90      2:28
  9. *:
  10. *:  Procs & Fncts: MAIN()
  11. *:
  12. *:      Documented 10/23/90 at 02:32                SNAP!  version 4.02
  13. *:*********************************************************************
  14.  
  15. /*
  16. *
  17. *   Compile with /m /n /w /a
  18. *
  19. */
  20.  
  21. #include "inkey.ch"
  22. #include "directry.ch"
  23. #include "dbstruct.ch"
  24. #include "box.ch"
  25. #include "setcurs.ch"
  26. #include "set.ch"
  27.  
  28. #command BEEP                         =>  OutErr( Chr(7) )
  29.  
  30. #translate fname_base( <filename> )   =>  ;
  31.    Trim( IIF( At (".", <filename> ) == 0, <filename>, ;
  32.    Substr( <filename>, 1, At( ".", <filename> ) - 1 )  ) )
  33.  
  34. #translate fname_ext( <filename> )    =>  ;
  35.    Trim( Substr( <filename>, At( ".", <filename> ) + 1 ) )
  36.  
  37. #define CHECKMARK "√"
  38.  
  39. MEMVAR getlist
  40.  
  41. FUNCTION main
  42.  
  43. LOCAL filename := SPACE(40),;        // get field
  44.       sourcename,;      // filename to convert
  45.       basename,;        // filename to convert with extension stripped off
  46.       src_struct,;      // structure of source file
  47.       des_struct,;      // structure of destination file
  48.       before,;          // file sizes of dbf/dbt files before conversion
  49.       after,;           // file sizes of dbf/dbv files after conversion
  50.       count,;           // progress counter
  51.       errorobj          // error object created on error
  52.  
  53. Set( _SET_SCOREBOARD, .F. )
  54. Set( _SET_CURSOR, SC_NONE )
  55.  
  56. DO WHILE .T.
  57.    SetColor( "bg+/b,gr+/n,b")
  58.    CLS
  59.    @ 0,0,23,79 BOX B_DOUBLE_SINGLE
  60.    @ 2,1 TO 2,79
  61.    @ 2,0 SAY "├"
  62.    @ 2,79 SAY "┤"
  63.    SetColor( "gr+/b")
  64.    @ 1,18 SAY "Flexfile .dbt to .dbv File Conversion Utility"
  65.    SetColor( "w+/b" )
  66.    keyline( 24, "Esc-Quit", {"Esc"} )
  67.    
  68.    @ 4,4 SAY "Enter name of file to convert:" GET filename PICTURE "@K!" ;
  69.       VALID ! EMPTY( filename )
  70.    Set( _SET_CURSOR, SC_NORMAL )
  71.    Set( _SET_INSERT, .F. )
  72.    SetKey( 22,;
  73.       {|| SetCursor( IIF( ReadInsert( ! ReadInsert() ), SC_NORMAL, SC_INSERT ) ) } )
  74.    READ
  75.    SetKey( 22, NIL )
  76.    Set( _SET_CURSOR, SC_NONE )
  77.    
  78.    IF LASTKEY() == K_ESC
  79.       Setcolor( "w/n,w/n,n" )
  80.       CLS
  81.       Set( _SET_CURSOR, SC_NORMAL )
  82.       QUIT
  83.    ENDIF
  84.    
  85.    sourcename := Alltrim( filename )
  86.    basename := fname_base( filename )
  87.    
  88.    IF sourcename == basename
  89.       sourcename += ".DBF"
  90.    ENDIF
  91.    
  92.    IF ! File( sourcename )
  93.       @ 6,4 SAY "File: " + sourcename + " not found"
  94.       BEEP
  95.       pressakey()
  96.       
  97.    ELSE
  98.       
  99.       USE (sourcename) NEW ALIAS source
  100.       src_struct = DbStruct()
  101.       
  102.       IF Ascan( src_struct, { |field| field[DBS_TYPE] == "M" } ) == 0
  103.          USE
  104.          @ 6,4 SAY "Nothing to convert"
  105.          @ 8,4 SAY sourcename + " does not contain any memo fields"
  106.          BEEP
  107.          pressakey()
  108.          
  109.       ELSE
  110.          keyline( 24, "Please wait a moment..." )
  111.          @ 6,4 SAY "Creating new dbf file..."
  112.          
  113.          * ..... copy structure of source file
  114.          des_struct = Aclone( src_struct )
  115.          
  116.          * ..... convert memo fields to character for dbv pointer
  117.          AEval( des_struct, { |field| ;
  118.             IIF( field[DBS_TYPE] == "M", field[DBS_LEN] := 6, NIL ) , ;
  119.             IIF( field[DBS_TYPE] == "M", field[DBS_TYPE] := "C", NIL ) } )
  120.          
  121.          * ..... create new dbf file with converted field types
  122.          DbCreate( basename + ".new", des_struct )
  123.          USE ( basename + ".new" ) ALIAS dest NEW
  124.          
  125.          QQout( CHECKMARK )
  126.          @ 8,4 SAY "Creating new dbv file..."
  127.          
  128.          IF File( basename + ".dbv")
  129.             Ferase( basename + ".dbv" )
  130.          ENDIF
  131.  
  132.          IF V_Use( basename ) == -1
  133.             errorobj := ErrorNew()
  134.             errorobj:description := "Open Error"
  135.             errorobj:operation := "V_USE()"
  136.             errorobj:filename := basename + ".dbv"
  137.             errorobj:subsystem := "Flexfile"
  138.             errorobj:subcode := V_Error()
  139.             Eval( ErrorBlock(), errorobj )
  140.          ENDIF
  141.  
  142.          
  143.          * ..... copy records to new dbf/dbv files
  144.          SELECT source
  145.          count := 0
  146.          QQout( CHECKMARK )
  147.          @ 10,4 SAY "Copying records - "
  148.          DbEval( {|| DevPos( 10, 22 ), ;
  149.             QQOut( Transform( ( ++count / Reccount() ) * 100, "999 % complete" ) ), ;
  150.             copyrec( src_struct ) } )
  151.          CLOSE DATABASES
  152.          V_Close( "tempfile.dbv" )
  153.          
  154.          before := filesize( basename + ".dbf" ) + filesize( basename + ".dbt" )
  155.          after := filesize( basename + ".new" ) + filesize( basename + ".dbv" )
  156.          
  157.          @ 12,4 SAY "Renaming " + IIF( At( ".", sourcename ) == 0, ;
  158.             basename + ".DBF" , sourcename ) + " to " + basename + ".BAK..."
  159.          IF FRename( sourcename, basename + ".bak" ) == -1
  160.             BEEP
  161.             @ 14,4 SAY "DOS error " + ntoc( Ferror() ) + " renaming file"
  162.             pressakey()
  163.          ELSE
  164.             FRename( basename + ".new", sourcename )
  165.             @ 14,4 SAY "Conversion complete."
  166.             @ 16,4 SAY "Filesize using memo fields: " + ntoc( before )
  167.             @ 17,4 SAY "Filesize using flexfile:    " + ntoc( after )
  168.             @ 19,4 SAY "You've saved " + ntoc( before - after ) + " bytes  (" + ;
  169.                ntoc( ( ( before - after ) / before ) * 100 ) + "%)"
  170.             pressakey()
  171.          ENDIF
  172.       ENDIF
  173.    ENDIF
  174. ENDDO
  175.  
  176.  
  177.  
  178. STATIC FUNCTION copyrec( struct )
  179. LOCAL x, numfields := Fcount(), errorobj
  180. SELECT dest
  181. APPEND BLANK
  182. FOR x := 1 TO numfields
  183.    IF struct[x][DBS_TYPE] == "M" .AND. ! EMPTY( source->( FieldGet( x ) ) )
  184.       FieldPut( x, V_Replace( source->( FieldGet( x ) ), '      ' ) )
  185.       IF V_Error() # 0
  186.          errorobj := ErrorNew()
  187.          errorobj:description := "Write Error"
  188.          errorobj:operation := "V_REPLACE()"
  189.          errorobj:filename := V_Filename()
  190.          errorobj:subsystem := "Flexfile"
  191.          errorobj:subcode := V_Error()
  192.          Eval( ErrorBlock(), errorobj )
  193.       ENDIF
  194.    ELSE
  195.       FieldPut( x, source->( FieldGet( x ) ) )
  196.    ENDIF
  197. NEXT
  198. SELECT source
  199. RETURN NIL
  200.  
  201.  
  202.  
  203. STATIC FUNCTION filesize( filename )
  204. LOCAL bytes := 0
  205. AEval( Directory( filename ), { |file| bytes += file[F_SIZE] } )
  206. RETURN bytes
  207.  
  208.  
  209.  
  210. STATIC FUNCTION keyline( line, txt, keys )
  211. LOCAL start_col := ( 80 - Len( txt ) ) / 2,;
  212.    savecolor := SetColor( IIF( IsColor(), "w+/b", "w+/n" ) )
  213. @ line,0 CLEAR TO line,79
  214. @ line,start_col-- SAY txt
  215. SETCOLOR( "n/w" )
  216. AEVAL( keys, {|x| DevPos( line, AT( x, txt ) + start_col ), DevOut( x ) } )
  217. SETCOLOR( savecolor )
  218. RETURN NIL
  219.  
  220.  
  221.  
  222. STATIC FUNCTION pressakey
  223. LOCAL savecolor := SetColor( "gr*+/b" )
  224. @ MaxRow(), 0 CLEAR
  225. @ MaxRow(), 33 SAY "Press any key..."
  226. CLEAR TYPEAHEAD
  227. Inkey(0)
  228. SetColor( savecolor )
  229. RETURN NIL
  230.  
  231.  
  232.  
  233. STATIC FUNCTION ntoc( numeric )
  234. LOCAL ret_val := STR( numeric ), pict
  235. pict := IIF( At( ".", ret_val ) == 0, "999,999,999", "999,999,999.99999" )
  236. RETURN AllTrim( Transform( numeric, pict ) )
  237.  
  238.  
  239. *: EOF: VCONVERT.PRG
  240. 
  241.